path_proj = here::here()
path_source = file.path(path_proj, "source")
# source(file.path(path_source, "simulation", "simulations_functions.R"))
source(file.path(path_source, "simulation", "simulations_functions_final.R"))
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
##
## Attaching package: 'tidyr'
## The following object is masked from 'package:reshape2':
##
## smiths
source(file.path(path_source, "functions", "plot_function.R"))
##
## Attaching package: 'gridExtra'
## The following object is masked from 'package:dplyr':
##
## combine
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
source(file.path(path_source, "functions", "fit_function.R"))
source(file.path(path_source, "functions", "table_function.R"))
#models
fixed_q <- file.path(path_proj, "source", "models",
"trunc", "1.stan_model_fixed_q_trunc.stan")
fixed_b <- file.path(path_proj, "source", "models",
"trunc", "2.stan_model_fixed_b_trunc.stan")
linear_b <- file.path(path_proj, "source", "models", "trunc",
"3.stan_model_linear_b_trunc.stan")
# ou_b <- file.path(path_proj, "source", "models", "trunc",
# "4.stan_model_ou_b_trunc.stan")
ou_b <- file.path(path_proj, "source", "models", "trunc",
"4.stan_model_ou_b_trunc.stan")
compiled_models <- list(
fixed_q = cmdstan_model(fixed_q),
fixed_b = cmdstan_model(fixed_b),
linear_b = cmdstan_model(linear_b),
ou_b = cmdstan_model(ou_b)
)
simulate data
settings and data
###### setting #####
seed <- 123
set.seed(seed)
# data
alpha_increase_seq_1 <- seq(10, 750, by = 30)
alpha_decrease_seq_1 <- seq(750, 10, by = -30)
alpha_lamb = c( rep(10,5), alpha_increase_seq_1 + rnorm(alpha_increase_seq_1,10,10),
alpha_decrease_seq_1 + rnorm(alpha_decrease_seq_1,10,10),
rep(10,5))
beta_lamb = 0.5
n_obs = 60
# reprot structure
D <- 10; D_complete <- 20; if_fully_reported <- F
# model
method = "ou";
alpha_ou=0.4; mu_ou=0.1; b_init=0.1;
# sd changes for each scenario
sigma_ou_1 = 0.01; sigma_ou_2 = 0.1; sigma_ou_3 = 0.3
# input list
params_1 <- list(
data = list(
alpha_lamb = alpha_lamb,
beta_lamb = beta_lamb,
n_obs = n_obs,
date_start = as.Date("2024-01-01"),
seed = seed
),
reporting = list(
D = D,
D_complete = D_complete,
if_fully_reported = if_fully_reported
),
q_model = list(
method = method,
method_params = list(alpha = alpha_ou, mu = mu_ou,
b_init = b_init, sigma_ou = sigma_ou_1)
)
)
# date that we run
#scoreRange <- seq(as.Date("2024-01-15"),as.Date("2024-02-29"),by="14 day")
scoreRange <- c(as.Date("2024-01-29"),as.Date("2024-02-12"), as.Date("2024-02-26"))
# generate
NFR_1 <- simulateData(params_1)
NFR_1$case_true - NFR_1$case_reported[,11]
## [,1]
## 2024-01-01 5
## 2024-01-02 5
## 2024-01-03 2
## 2024-01-04 5
## 2024-01-05 1
## 2024-01-06 5
## 2024-01-07 32
## 2024-01-08 36
## 2024-01-09 53
## 2024-01-10 83
## 2024-01-11 80
## 2024-01-12 85
## 2024-01-13 101
## 2024-01-14 104
## 2024-01-15 103
## 2024-01-16 176
## 2024-01-17 155
## 2024-01-18 173
## 2024-01-19 198
## 2024-01-20 209
## 2024-01-21 235
## 2024-01-22 270
## 2024-01-23 264
## 2024-01-24 348
## 2024-01-25 287
## 2024-01-26 340
## 2024-01-27 375
## 2024-01-28 335
## 2024-01-29 330
## 2024-01-30 454
## 2024-01-31 354
## 2024-02-01 363
## 2024-02-02 334
## 2024-02-03 269
## 2024-02-04 272
## 2024-02-05 253
## 2024-02-06 219
## 2024-02-07 258
## 2024-02-08 246
## 2024-02-09 211
## 2024-02-10 245
## 2024-02-11 198
## 2024-02-12 174
## 2024-02-13 210
## 2024-02-14 137
## 2024-02-15 129
## 2024-02-16 152
## 2024-02-17 120
## 2024-02-18 148
## 2024-02-19 88
## 2024-02-20 83
## 2024-02-21 55
## 2024-02-22 52
## 2024-02-23 39
## 2024-02-24 10
## 2024-02-25 6
## 2024-02-26 5
## 2024-02-27 4
## 2024-02-28 2
## 2024-02-29 4
# input list
params_2 <- list(
data = list(
alpha_lamb = alpha_lamb,
beta_lamb = beta_lamb,
n_obs = n_obs,
date_start = as.Date("2024-01-01"),
seed = seed
),
reporting = list(
D = D,
D_complete = D_complete,
if_fully_reported = if_fully_reported
),
q_model = list(
method = method,
method_params = list(alpha = alpha_ou, mu = mu_ou,
b_init = b_init, sigma_ou = sigma_ou_2)
)
)
NFR_2 <- simulateData(params_2)
# input list
params_3 <- list(
data = list(
alpha_lamb = alpha_lamb,
beta_lamb = beta_lamb,
n_obs = n_obs,
date_start = as.Date("2024-01-01"),
seed = seed
),
reporting = list(
D = D,
D_complete = D_complete,
if_fully_reported = if_fully_reported
),
q_model = list(
method = method,
method_params = list(alpha = alpha_ou, mu = mu_ou,
b_init = b_init, sigma_ou = sigma_ou_3)
)
)
NFR_3 <- simulateData(params_3)
# sum(abs(NFR_3$b_t - NFR_2$b_t))
#
# sum(abs(NFR_3$b_t - NFR_1$b_t))
# exploritary analysis
page_num <- ceiling(nrow(NFR_1$case_reported)/16)
exp_plot_1 <- fit_exp_plot(NFR_1$case_reported,ncol = 4, nrow = 4, page = c(1:page_num), if_fit = T)
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
print(exp_plot_1)
## $plots
## $plots[[1]]
##
## $plots[[2]]
##
## $plots[[3]]
##
## $plots[[4]]
##
##
## $coefficients
## [1] 0.2105931 0.2219158 0.2159207 0.2990013 0.4099746 0.3171161 0.2359877
## [8] 0.2730551 0.2461156 0.2497658 0.2346689 0.2519211 0.2533770 0.2360473
## [15] 0.2789757 0.2453954 0.2600374 0.2538420 0.2489041 0.2281507 0.2622954
## [22] 0.2428566 0.2288874 0.2336581 0.2234104 0.2308562 0.2159729 0.2458706
## [29] 0.2376184 0.2433125 0.2573410 0.2621895 0.2546451 0.2397534 0.2563264
## [36] 0.2512215 0.2707787 0.2608908 0.2566289 0.2521653 0.2470580 0.2413217
## [43] 0.2460213 0.2478304 0.2707713 0.2538695 0.2324176 0.2381676 0.2597254
## [50] 0.2381342 0.2386385 0.2319907 0.2812387 0.2563079 0.2620299 0.1831054
## [57] 0.1985240 0.2105563 0.2730887 0.2026453
exp_b_data_1<- data.frame( date = as.Date(rownames(NFR_1$case_reported)),
b = exp_plot_1$coefficients)
exp_b_data_1
## date b
## 1 2024-01-01 0.2105931
## 2 2024-01-02 0.2219158
## 3 2024-01-03 0.2159207
## 4 2024-01-04 0.2990013
## 5 2024-01-05 0.4099746
## 6 2024-01-06 0.3171161
## 7 2024-01-07 0.2359877
## 8 2024-01-08 0.2730551
## 9 2024-01-09 0.2461156
## 10 2024-01-10 0.2497658
## 11 2024-01-11 0.2346689
## 12 2024-01-12 0.2519211
## 13 2024-01-13 0.2533770
## 14 2024-01-14 0.2360473
## 15 2024-01-15 0.2789757
## 16 2024-01-16 0.2453954
## 17 2024-01-17 0.2600374
## 18 2024-01-18 0.2538420
## 19 2024-01-19 0.2489041
## 20 2024-01-20 0.2281507
## 21 2024-01-21 0.2622954
## 22 2024-01-22 0.2428566
## 23 2024-01-23 0.2288874
## 24 2024-01-24 0.2336581
## 25 2024-01-25 0.2234104
## 26 2024-01-26 0.2308562
## 27 2024-01-27 0.2159729
## 28 2024-01-28 0.2458706
## 29 2024-01-29 0.2376184
## 30 2024-01-30 0.2433125
## 31 2024-01-31 0.2573410
## 32 2024-02-01 0.2621895
## 33 2024-02-02 0.2546451
## 34 2024-02-03 0.2397534
## 35 2024-02-04 0.2563264
## 36 2024-02-05 0.2512215
## 37 2024-02-06 0.2707787
## 38 2024-02-07 0.2608908
## 39 2024-02-08 0.2566289
## 40 2024-02-09 0.2521653
## 41 2024-02-10 0.2470580
## 42 2024-02-11 0.2413217
## 43 2024-02-12 0.2460213
## 44 2024-02-13 0.2478304
## 45 2024-02-14 0.2707713
## 46 2024-02-15 0.2538695
## 47 2024-02-16 0.2324176
## 48 2024-02-17 0.2381676
## 49 2024-02-18 0.2597254
## 50 2024-02-19 0.2381342
## 51 2024-02-20 0.2386385
## 52 2024-02-21 0.2319907
## 53 2024-02-22 0.2812387
## 54 2024-02-23 0.2563079
## 55 2024-02-24 0.2620299
## 56 2024-02-25 0.1831054
## 57 2024-02-26 0.1985240
## 58 2024-02-27 0.2105563
## 59 2024-02-28 0.2730887
## 60 2024-02-29 0.2026453
exp_b_plot_1 <- ggplot(exp_b_data_1, aes(x = date, y = b)) +
geom_point(color = "black", size = 1.5) +
geom_smooth(method = "loess", se = TRUE,
color = "blue", fill = "grey", alpha = 0.5) +
theme_minimal() +
labs(x = NULL, y = "Y", title = "Smoothed Curve of parameter b")
print(exp_b_plot_1)
## `geom_smooth()` using formula = 'y ~ x'
# exploritary analysis
exp_plot_2 <- fit_exp_plot(NFR_2$case_reported,ncol = 4, nrow = 4, page = c(1:page_num), if_fit = T)
print(exp_plot_2)
## $plots
## $plots[[1]]
##
## $plots[[2]]
##
## $plots[[3]]
##
## $plots[[4]]
##
##
## $coefficients
## [1] 0.2105931 0.2327553 0.1849933 0.4061328 0.4638253 0.2824681 0.4573651
## [8] 0.4039136 0.2343272 0.2281481 0.2157325 0.3678367 0.3040318 0.3238031
## [15] 0.2976343 0.2318188 0.4025771 0.3757003 0.2096965 0.2738696 0.2314441
## [22] 0.2155385 0.2147517 0.2106137 0.2314005 0.2088538 0.2144190 0.2924279
## [29] 0.3053937 0.2140686 0.3400130 0.3555002 0.2785592 0.3421714 0.3842366
## [36] 0.4185624 0.4435835 0.3934004 0.3405828 0.2656149 0.2452760 0.1961528
## [43] 0.2162986 0.2146876 0.4560132 0.4895872 0.2582195 0.2441234 0.2099607
## [50] 0.2619035 0.2562234 0.2669170 0.2845648 0.2382865 0.3367767 0.2588824
## [57] 0.7666945 0.1847625 0.2848255 0.3123496
exp_b_data_2<- data.frame( date = as.Date(rownames(NFR_2$case_reported)),
b = exp_plot_2$coefficients)
exp_b_data_2
## date b
## 1 2024-01-01 0.2105931
## 2 2024-01-02 0.2327553
## 3 2024-01-03 0.1849933
## 4 2024-01-04 0.4061328
## 5 2024-01-05 0.4638253
## 6 2024-01-06 0.2824681
## 7 2024-01-07 0.4573651
## 8 2024-01-08 0.4039136
## 9 2024-01-09 0.2343272
## 10 2024-01-10 0.2281481
## 11 2024-01-11 0.2157325
## 12 2024-01-12 0.3678367
## 13 2024-01-13 0.3040318
## 14 2024-01-14 0.3238031
## 15 2024-01-15 0.2976343
## 16 2024-01-16 0.2318188
## 17 2024-01-17 0.4025771
## 18 2024-01-18 0.3757003
## 19 2024-01-19 0.2096965
## 20 2024-01-20 0.2738696
## 21 2024-01-21 0.2314441
## 22 2024-01-22 0.2155385
## 23 2024-01-23 0.2147517
## 24 2024-01-24 0.2106137
## 25 2024-01-25 0.2314005
## 26 2024-01-26 0.2088538
## 27 2024-01-27 0.2144190
## 28 2024-01-28 0.2924279
## 29 2024-01-29 0.3053937
## 30 2024-01-30 0.2140686
## 31 2024-01-31 0.3400130
## 32 2024-02-01 0.3555002
## 33 2024-02-02 0.2785592
## 34 2024-02-03 0.3421714
## 35 2024-02-04 0.3842366
## 36 2024-02-05 0.4185624
## 37 2024-02-06 0.4435835
## 38 2024-02-07 0.3934004
## 39 2024-02-08 0.3405828
## 40 2024-02-09 0.2656149
## 41 2024-02-10 0.2452760
## 42 2024-02-11 0.1961528
## 43 2024-02-12 0.2162986
## 44 2024-02-13 0.2146876
## 45 2024-02-14 0.4560132
## 46 2024-02-15 0.4895872
## 47 2024-02-16 0.2582195
## 48 2024-02-17 0.2441234
## 49 2024-02-18 0.2099607
## 50 2024-02-19 0.2619035
## 51 2024-02-20 0.2562234
## 52 2024-02-21 0.2669170
## 53 2024-02-22 0.2845648
## 54 2024-02-23 0.2382865
## 55 2024-02-24 0.3367767
## 56 2024-02-25 0.2588824
## 57 2024-02-26 0.7666945
## 58 2024-02-27 0.1847625
## 59 2024-02-28 0.2848255
## 60 2024-02-29 0.3123496
exp_b_plot_2 <- ggplot(exp_b_data_2, aes(x = date, y = b)) +
geom_point(color = "black", size = 1.5) +
geom_smooth(method = "loess", se = TRUE,
color = "blue", fill = "grey", alpha = 0.5) +
theme_minimal() +
labs(x = NULL, y = "Y", title = "Smoothed Curve of parameter b")
print(exp_b_plot_2)
## `geom_smooth()` using formula = 'y ~ x'
# exploritary analysis
exp_plot_3 <- fit_exp_plot(NFR_3$case_reported,ncol = 4, nrow = 4, page = c(1:page_num), if_fit = T)
print(exp_plot_3)
## $plots
## $plots[[1]]
##
## $plots[[2]]
##
## $plots[[3]]
##
## $plots[[4]]
##
##
## $coefficients
## [1] 0.2105931 0.2327553 0.1849933 1.0828929 0.4030423 0.4126832 0.9199790
## [8] 1.3963437 0.2021116 0.1834190 0.2125619 0.6830153 0.6087582 0.6145139
## [15] 0.4789046 0.2105990 0.9791390 0.9799536 0.2151569 0.4520575 0.2307329
## [22] 0.2176048 0.2099771 0.2185176 0.2164949 0.2091678 0.2112425 0.5210582
## [29] 0.4115627 0.2079285 0.6903262 0.7339282 0.3468466 0.6520593 1.0037778
## [36] 1.0632529 1.1069546 0.9946626 0.5793488 0.2993754 0.2148595 0.2193594
## [43] 0.2141952 0.1985096 1.3583691 1.6751566 0.3449601 0.2114738 0.2215359
## [50] 0.4985780 0.3237720 0.3657669 0.3273352 0.2446450 0.7857777 0.4350622
## [57] 1.1171029 0.5526202 0.4319583 0.3106186
exp_b_data_3<- data.frame( date = as.Date(rownames(NFR_3$case_reported)),
b = exp_plot_3$coefficients)
exp_b_data_3
## date b
## 1 2024-01-01 0.2105931
## 2 2024-01-02 0.2327553
## 3 2024-01-03 0.1849933
## 4 2024-01-04 1.0828929
## 5 2024-01-05 0.4030423
## 6 2024-01-06 0.4126832
## 7 2024-01-07 0.9199790
## 8 2024-01-08 1.3963437
## 9 2024-01-09 0.2021116
## 10 2024-01-10 0.1834190
## 11 2024-01-11 0.2125619
## 12 2024-01-12 0.6830153
## 13 2024-01-13 0.6087582
## 14 2024-01-14 0.6145139
## 15 2024-01-15 0.4789046
## 16 2024-01-16 0.2105990
## 17 2024-01-17 0.9791390
## 18 2024-01-18 0.9799536
## 19 2024-01-19 0.2151569
## 20 2024-01-20 0.4520575
## 21 2024-01-21 0.2307329
## 22 2024-01-22 0.2176048
## 23 2024-01-23 0.2099771
## 24 2024-01-24 0.2185176
## 25 2024-01-25 0.2164949
## 26 2024-01-26 0.2091678
## 27 2024-01-27 0.2112425
## 28 2024-01-28 0.5210582
## 29 2024-01-29 0.4115627
## 30 2024-01-30 0.2079285
## 31 2024-01-31 0.6903262
## 32 2024-02-01 0.7339282
## 33 2024-02-02 0.3468466
## 34 2024-02-03 0.6520593
## 35 2024-02-04 1.0037778
## 36 2024-02-05 1.0632529
## 37 2024-02-06 1.1069546
## 38 2024-02-07 0.9946626
## 39 2024-02-08 0.5793488
## 40 2024-02-09 0.2993754
## 41 2024-02-10 0.2148595
## 42 2024-02-11 0.2193594
## 43 2024-02-12 0.2141952
## 44 2024-02-13 0.1985096
## 45 2024-02-14 1.3583691
## 46 2024-02-15 1.6751566
## 47 2024-02-16 0.3449601
## 48 2024-02-17 0.2114738
## 49 2024-02-18 0.2215359
## 50 2024-02-19 0.4985780
## 51 2024-02-20 0.3237720
## 52 2024-02-21 0.3657669
## 53 2024-02-22 0.3273352
## 54 2024-02-23 0.2446450
## 55 2024-02-24 0.7857777
## 56 2024-02-25 0.4350622
## 57 2024-02-26 1.1171029
## 58 2024-02-27 0.5526202
## 59 2024-02-28 0.4319583
## 60 2024-02-29 0.3106186
exp_b_plot_3 <- ggplot(exp_b_data_3, aes(x = date, y = b)) +
geom_point(color = "black", size = 1.5) +
geom_smooth(method = "loess", se = TRUE,
color = "blue", fill = "grey", alpha = 0.5) +
theme_minimal() +
labs(x = NULL, y = "Y", title = "Smoothed Curve of parameter b")
print(exp_b_plot_3)
## `geom_smooth()` using formula = 'y ~ x'
fit model
out_1_NFR <- nowcasting_moving_window(NFR_1$case_reported, scoreRange = scoreRange,
case_true = NFR_1$case_true,
start_date = as.Date("2024-01-01"),
D = D, sigma_b = 0.1, seeds = seed,
models_to_run =c("fixed_q", "fixed_b", "linear_b", "ou_b"),
compiled_models = compiled_models,
iter_sampling = 2000, iter_warmup = 1000, refresh = 0,
num_chains = 3, suppress_output = T)
## ====================
## now=2024-01-29 (1/3)
## ====================
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 1.2 seconds.
## Chain 2 finished in 1.2 seconds.
## Chain 3 finished in 1.2 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 1.2 seconds.
## Total execution time: 3.9 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 25.4 seconds.
## Chain 2 finished in 36.9 seconds.
## Chain 3 finished in 41.8 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 34.7 seconds.
## Total execution time: 104.5 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 1.1 seconds.
## Chain 2 finished in 11.8 seconds.
## Chain 3 finished in 8.6 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 7.1 seconds.
## Total execution time: 21.7 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 7.1 seconds.
## Chain 2 finished in 8.5 seconds.
## Chain 3 finished in 7.4 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 7.7 seconds.
## Total execution time: 23.3 seconds.
##
## ====================
## now=2024-02-12 (2/3)
## ====================
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 2.0 seconds.
## Chain 2 finished in 2.0 seconds.
## Chain 3 finished in 2.7 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 2.2 seconds.
## Total execution time: 7.0 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 1.6 seconds.
## Chain 2 finished in 1.4 seconds.
## Chain 3 finished in 2.1 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 1.7 seconds.
## Total execution time: 5.5 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 23.2 seconds.
## Chain 2 finished in 19.9 seconds.
## Chain 3 finished in 20.0 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 21.0 seconds.
## Total execution time: 63.5 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 12.6 seconds.
## Chain 2 finished in 17.2 seconds.
## Chain 3 finished in 15.9 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 15.2 seconds.
## Total execution time: 46.0 seconds.
##
## ====================
## now=2024-02-26 (3/3)
## ====================
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 5.2 seconds.
## Chain 2 finished in 2.7 seconds.
## Chain 3 finished in 2.8 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 3.6 seconds.
## Total execution time: 11.0 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 3.0 seconds.
## Chain 2 finished in 1.7 seconds.
## Chain 3 finished in 2.1 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 2.3 seconds.
## Total execution time: 7.0 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 43.6 seconds.
## Chain 2 finished in 29.0 seconds.
## Chain 3 finished in 4.8 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 25.8 seconds.
## Total execution time: 77.7 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 20.1 seconds.
## Chain 2 finished in 20.9 seconds.
## Chain 3 finished in 19.5 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 20.2 seconds.
## Total execution time: 60.7 seconds.
#save(out_1_NFR, file = file.path(path_proj, "data", "fitted_model", "simulation_ou", "NotFR_b01_sd001.RData"))
#load(file.path(path_proj,"data", "fitted_model", "simulation", "NotFR_b01_sd001.RData"))
results_1_NFR <- nowcasts_table(out_1_NFR, D = D, report_unit = "day",
models_to_run = c("fixed_q", "fixed_b", "linear_b", "ou_b"))
results_1_NFR_plots <- nowcasts_plot(results_1_NFR, D = D, report_unit = "day", models_to_run = c("fixed_q", "fixed_b", "linear_b" , "ou_b"))
## Warning: The `size` argument of `element_rect()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
out_2_NFR <- nowcasting_moving_window(NFR_2$case_reported, scoreRange = scoreRange,
case_true = NFR_2$case_true,
start_date = as.Date("2024-01-01"),
D = D, sigma_b = 0.1, seeds = seed,
models_to_run =c("fixed_q", "fixed_b", "linear_b", "ou_b"),
compiled_models = compiled_models,
iter_sampling = 2000, iter_warmup = 1000, refresh = 0,
num_chains = 3, suppress_output = T)
## ====================
## now=2024-01-29 (1/3)
## ====================
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 1.5 seconds.
## Chain 2 finished in 1.5 seconds.
## Chain 3 finished in 1.6 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 1.6 seconds.
## Total execution time: 4.9 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 26.0 seconds.
## Chain 2 finished in 34.1 seconds.
## Chain 3 finished in 23.9 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 28.0 seconds.
## Total execution time: 84.3 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 8.3 seconds.
## Chain 2 finished in 10.5 seconds.
## Chain 3 finished in 8.3 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 9.0 seconds.
## Total execution time: 27.4 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 13.1 seconds.
## Chain 2 finished in 13.9 seconds.
## Chain 3 finished in 12.5 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 13.2 seconds.
## Total execution time: 39.8 seconds.
##
## ====================
## now=2024-02-12 (2/3)
## ====================
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 5.6 seconds.
## Chain 2 finished in 1.8 seconds.
## Chain 3 finished in 2.0 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 3.1 seconds.
## Total execution time: 9.7 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 4.5 seconds.
## Chain 2 finished in 1.2 seconds.
## Chain 3 finished in 1.2 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 2.3 seconds.
## Total execution time: 7.2 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 23.3 seconds.
## Chain 2 finished in 19.9 seconds.
## Chain 3 finished in 20.6 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 21.3 seconds.
## Total execution time: 64.0 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 20.1 seconds.
## Chain 2 finished in 19.4 seconds.
## Chain 3 finished in 18.3 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 19.3 seconds.
## Total execution time: 58.2 seconds.
##
## ====================
## now=2024-02-26 (3/3)
## ====================
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 2.5 seconds.
## Chain 2 finished in 2.3 seconds.
## Chain 3 finished in 2.3 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 2.4 seconds.
## Total execution time: 7.5 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 1.6 seconds.
## Chain 2 finished in 2.0 seconds.
## Chain 3 finished in 2.3 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 2.0 seconds.
## Total execution time: 6.3 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 3.2 seconds.
## Chain 2 finished in 23.5 seconds.
## Chain 3 finished in 2.4 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 9.7 seconds.
## Total execution time: 29.4 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 27.4 seconds.
## Chain 2 finished in 30.0 seconds.
## Chain 3 finished in 29.1 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 28.8 seconds.
## Total execution time: 86.8 seconds.
#save(out_2_NFR, file = file.path(path_proj, "data", "fitted_model", "simulation_ou", "NotFR_b01_sd01.RData"))
#load(file.path(path_proj,"data", "fitted_model", "simulation", "NotFR_b01_sd001.RData"))
results_2_NFR <- nowcasts_table(out_2_NFR, D = D, report_unit = "day",
models_to_run = c("fixed_q", "fixed_b", "linear_b", "ou_b"))
results_2_NFR_plots <- nowcasts_plot(results_2_NFR, D = D, report_unit = "day", models_to_run = c("fixed_q", "fixed_b", "linear_b" , "ou_b"))
out_3_NFR <- nowcasting_moving_window(NFR_3$case_reported, scoreRange = scoreRange,
case_true = NFR_3$case_true,
start_date = as.Date("2024-01-01"),
D = D, sigma_b = 0.1, seeds = seed,
models_to_run =c("fixed_q", "fixed_b", "linear_b", "ou_b"),
compiled_models = compiled_models,
iter_sampling = 2000, iter_warmup = 1000, refresh = 0,
num_chains = 3, suppress_output = T)
## ====================
## now=2024-01-29 (1/3)
## ====================
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 1.6 seconds.
## Chain 2 finished in 1.6 seconds.
## Chain 3 finished in 1.6 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 1.6 seconds.
## Total execution time: 5.1 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 1.9 seconds.
## Chain 2 finished in 0.9 seconds.
## Chain 3 finished in 1.0 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 1.2 seconds.
## Total execution time: 4.1 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 13.9 seconds.
## Chain 2 finished in 10.5 seconds.
## Chain 3 finished in 11.5 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 12.0 seconds.
## Total execution time: 36.3 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 13.3 seconds.
## Chain 2 finished in 12.6 seconds.
## Chain 3 finished in 12.7 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 12.9 seconds.
## Total execution time: 38.9 seconds.
##
## ====================
## now=2024-02-12 (2/3)
## ====================
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 1.9 seconds.
## Chain 2 finished in 2.0 seconds.
## Chain 3 finished in 1.9 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 1.9 seconds.
## Total execution time: 6.0 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 1.7 seconds.
## Chain 2 finished in 1.3 seconds.
## Chain 3 finished in 1.1 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 1.4 seconds.
## Total execution time: 4.4 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 21.7 seconds.
## Chain 2 finished in 2.0 seconds.
## Chain 3 finished in 26.0 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 16.6 seconds.
## Total execution time: 50.0 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 22.7 seconds.
## Chain 2 finished in 22.4 seconds.
## Chain 3 finished in 22.5 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 22.5 seconds.
## Total execution time: 67.9 seconds.
##
## ====================
## now=2024-02-26 (3/3)
## ====================
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 3.2 seconds.
## Chain 2 finished in 3.0 seconds.
## Chain 3 finished in 3.3 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 3.2 seconds.
## Total execution time: 9.9 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 4.3 seconds.
## Chain 2 finished in 2.1 seconds.
## Chain 3 finished in 3.5 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 3.3 seconds.
## Total execution time: 10.3 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 3.0 seconds.
## Chain 2 finished in 59.8 seconds.
## Chain 3 finished in 41.9 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 34.9 seconds.
## Total execution time: 105.1 seconds.
##
## Running MCMC with 3 sequential chains...
##
## Chain 1 finished in 31.1 seconds.
## Chain 2 finished in 31.1 seconds.
## Chain 3 finished in 31.7 seconds.
##
## All 3 chains finished successfully.
## Mean chain execution time: 31.3 seconds.
## Total execution time: 94.3 seconds.
#save(out_3_NFR, file = file.path(path_proj, "data", "fitted_model", "simulation_ou", "NotFR_b01_sd03.RData"))
#load(file.path(path_proj,"data", "fitted_model", "simulation", "NotFR_b01_sd001.RData"))
results_3_NFR <- nowcasts_table(out_3_NFR, D = D, report_unit = "day",
models_to_run = c("fixed_q", "fixed_b", "linear_b", "ou_b"))
results_3_NFR_plots <- nowcasts_plot(results_3_NFR, D = D, report_unit = "day", models_to_run = c("fixed_q", "fixed_b", "linear_b" , "ou_b"))
check results
results_1_NFR_plots
## [[1]]
##
## [[2]]
##
## [[3]]
# all cases
for(i in 1:length(results_1_NFR)){
print(calculate_metrics(results_1_NFR[[i]]))
}
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 228.93 28.28 170.53 26.30 96.11 0.17 fixed_q
## 2 283.13 32.42 191.25 30.08 706.11 0.97 fixed_b
## 3 546.01 446.73 414.44 222.55 206.49 0.41 linear_b
## 4 97.89 23.20 77.35 19.60 263.81 0.66 ou_b
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 226.31 25.03 187.66 23.58 104.35 0.14 fixed_q
## 2 918.08 97.68 781.29 97.43 9.81 0.05 fixed_b
## 3 565.94 808.35 512.99 331.39 198.13 0.09 linear_b
## 4 182.21 25.41 150.74 22.95 342.85 0.49 ou_b
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 207.62 24.76 166.60 23.32 88.90 0.14 fixed_q
## 2 826.87 98.46 679.23 98.39 7.21 0.00 fixed_b
## 3 442.65 415.94 376.05 166.20 206.24 0.25 linear_b
## 4 153.47 28.14 124.67 24.04 247.57 0.40 ou_b
# Within D
for(i in 1:length(results_1_NFR)){
print(calculate_metrics(data.table::last(results_1_NFR[[i]], D)))
}
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 365.36 31.80 353.39 31.24 168.81 0.0 fixed_q
## 2 469.35 38.73 432.41 37.05 1298.51 0.9 fixed_b
## 3 873.31 73.74 837.76 72.88 73.50 0.0 linear_b
## 4 128.75 11.96 111.78 10.36 529.33 0.9 ou_b
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 220.68 21.81 216.20 21.19 160.40 0.1 fixed_q
## 2 1047.60 99.75 1034.56 99.75 8.00 0.0 fixed_b
## 3 704.70 70.54 702.77 69.53 76.61 0.0 linear_b
## 4 199.99 19.44 191.25 18.40 588.81 0.7 ou_b
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 77.93 22.11 60.89 20.03 62.50 0.3 fixed_q
## 2 305.45 98.05 248.47 98.01 6.90 0.0 fixed_b
## 3 187.67 70.01 158.46 69.39 35.30 0.0 linear_b
## 4 72.26 43.25 63.34 37.12 176.41 0.7 ou_b
sigma_rw = 0.1
results_2_NFR_plots
## [[1]]
##
## [[2]]
##
## [[3]]
# all cases
for(i in 1:length(results_2_NFR)){
print(calculate_metrics(results_2_NFR[[i]]))
}
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 301.14 35.17 195.28 28.80 91.73 0.45 fixed_q
## 2 468.14 55.50 332.65 51.94 518.42 0.55 fixed_b
## 3 564.65 693.83 438.65 326.78 158.52 0.14 linear_b
## 4 143.44 19.65 80.21 13.50 423.06 0.93 ou_b
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 264.49 30.39 188.53 24.72 105.56 0.40 fixed_q
## 2 928.35 97.75 790.27 97.49 7.88 0.05 fixed_b
## 3 549.81 933.38 489.60 372.78 244.87 0.12 linear_b
## 4 184.68 20.77 114.34 14.58 343.71 0.81 ou_b
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 234.94 31.38 159.05 24.92 89.28 0.37 fixed_q
## 2 832.31 98.39 679.60 98.32 6.84 0.00 fixed_b
## 3 401.15 228.10 326.12 105.16 203.23 0.25 linear_b
## 4 162.94 34.13 95.11 18.15 254.87 0.84 ou_b
# Within D
for(i in 1:length(results_2_NFR)){
print(calculate_metrics(data.table::last(results_2_NFR[[i]], D)))
}
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 486.57 42.33 443.82 39.22 154.11 0.1 fixed_q
## 2 758.96 65.06 734.86 64.02 918.01 0.3 fixed_b
## 3 883.17 74.58 852.52 73.76 73.20 0.0 linear_b
## 4 223.36 19.73 173.55 15.36 991.24 0.9 ou_b
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 282.46 30.50 244.44 24.91 164.71 0.2 fixed_q
## 2 1112.47 99.76 1093.82 99.76 8.40 0.0 fixed_b
## 3 611.79 62.21 596.67 58.10 89.80 0.0 linear_b
## 4 141.15 16.22 99.72 10.74 625.02 1.0 ou_b
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 101.59 38.09 70.38 29.80 56.41 0.3 fixed_q
## 2 287.59 97.62 226.59 97.55 6.90 0.0 fixed_b
## 3 178.03 65.82 142.38 65.47 34.60 0.0 linear_b
## 4 58.10 68.88 37.26 38.05 238.51 1.0 ou_b
sigma_rw = 0.3
results_3_NFR_plots
## [[1]]
##
## [[2]]
##
## [[3]]
# all cases
for(i in 1:length(results_3_NFR)){
print(calculate_metrics(results_3_NFR[[i]]))
}
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 353.34 41.83 228.17 33.95 87.45 0.34 fixed_q
## 2 723.85 92.47 553.78 90.87 98.83 0.00 fixed_b
## 3 552.10 755.31 427.53 350.49 196.21 0.17 linear_b
## 4 123.66 18.48 69.26 10.99 422.74 0.97 ou_b
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 331.42 38.27 252.98 32.69 103.86 0.21 fixed_q
## 2 917.02 98.10 784.69 97.93 7.40 0.02 fixed_b
## 3 470.45 664.15 390.68 269.55 367.57 0.40 linear_b
## 4 206.11 22.99 115.34 14.11 294.81 0.84 ou_b
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 267.69 34.98 188.70 29.04 90.42 0.25 fixed_q
## 2 823.92 98.72 678.89 98.68 6.60 0.00 fixed_b
## 3 371.85 484.42 290.70 177.67 253.64 0.32 linear_b
## 4 169.19 25.91 91.31 15.30 233.65 0.84 ou_b
# Within D
for(i in 1:length(results_3_NFR)){
print(calculate_metrics(data.table::last(results_3_NFR[[i]], D)))
}
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 568.21 50.26 499.64 44.29 139.51 0.2 fixed_q
## 2 1136.07 96.89 1110.13 96.31 72.90 0.0 fixed_b
## 3 842.23 71.20 807.81 69.45 79.80 0.0 linear_b
## 4 188.13 16.08 149.22 12.86 998.64 1.0 ou_b
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 443.50 45.08 418.69 40.90 153.50 0 fixed_q
## 2 1090.34 99.77 1078.52 99.77 8.00 0 fixed_b
## 3 513.91 55.59 444.45 45.52 99.90 0 linear_b
## 4 228.58 25.95 139.02 15.49 492.93 1 ou_b
## RMSE RMSPE MAE MAPE Interval_Width Coverage_Rate Method
## 1 126.07 35.72 82.82 31.46 57.60 0.3 fixed_q
## 2 299.31 98.40 242.21 98.38 6.80 0.0 fixed_b
## 3 174.70 59.14 134.93 57.29 40.30 0.0 linear_b
## 4 68.40 42.41 46.74 27.79 246.51 1.0 ou_b
output
results_1_NFR_plots <- nowcasts_plot(results_1_NFR, D = D, report_unit = "day",
models_to_run = c("fixed_q", "fixed_b", "linear_b" , "ou_b"),
combine_plots = T, ncol = 2
)
ggsave(filename = file.path(path_proj, "plots_to_show", "simulation", "NotFR_b01_sd001.png"),
plot = results_1_NFR_plots,
width = 10, height = 12, dpi = 300)
# table
fully_tables_1 <- list();count_1 = 1
for (i in 1:length(scoreRange)) {
fully_tables_1[[count_1]] <- calculate_metrics(results_1_NFR[[i]])
count_1 = count_1 + 1
}
cat(highlight_metrics(fully_tables_1, method_names =c("Fixed q", "Fixed b", "Polynomial b" , "Random Walk b"),
date_labels = as.character(scoreRange)))
## \begin{table}[htbp]
## \centering
## \caption{Metrics Comparison}
## \begin{tabular}{c|c|c|c|c|c|c|c}
## \hline
## Scenario & RMSE & RMSPE & MAE & MAPE & Interval Width & Coverage Rate & Method \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-01-29}} \\
## \hline
## & 228.93 & 28.28 & 170.53 & 26.30 & \textcolor{red}{96.11} & 0.17 & Fixed q \\
## & 283.13 & 32.42 & 191.25 & 30.08 & 706.11 & \textcolor{red}{0.97} & Fixed b \\
## & 546.01 & 446.73 & 414.44 & 222.55 & 206.49 & 0.41 & Polynomial b \\
## & \textcolor{red}{97.89} & \textcolor{red}{23.20} & \textcolor{red}{77.35} & \textcolor{red}{19.60} & 263.81 & 0.66 & Random Walk b \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-02-12}} \\
## \hline
## & 226.31 & \textcolor{red}{25.03} & 187.66 & 23.58 & 104.35 & 0.14 & Fixed q \\
## & 918.08 & 97.68 & 781.29 & 97.43 & \textcolor{red}{9.81} & 0.05 & Fixed b \\
## & 565.94 & 808.35 & 512.99 & 331.39 & 198.13 & 0.09 & Polynomial b \\
## & \textcolor{red}{182.21} & 25.41 & \textcolor{red}{150.74} & \textcolor{red}{22.95} & 342.85 & \textcolor{red}{0.49} & Random Walk b \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-02-26}} \\
## \hline
## & 207.62 & \textcolor{red}{24.76} & 166.60 & \textcolor{red}{23.32} & 88.90 & 0.14 & Fixed q \\
## & 826.87 & 98.46 & 679.23 & 98.39 & \textcolor{red}{7.21} & 0.00 & Fixed b \\
## & 442.65 & 415.94 & 376.05 & 166.20 & 206.24 & 0.25 & Polynomial b \\
## & \textcolor{red}{153.47} & 28.14 & \textcolor{red}{124.67} & 24.04 & 247.57 & \textcolor{red}{0.40} & Random Walk b \\
## \hline
## \end{tabular}
## \end{table}
output
results_2_NFR_plots <- nowcasts_plot(results_2_NFR, D = D, report_unit = "day",
models_to_run = c("fixed_q", "fixed_b", "linear_b" , "ou_b"),
combine_plots = T, ncol = 2
)
ggsave(filename = file.path(path_proj, "plots_to_show", "simulation", "NotFR_b01_sd01.png"),
plot = results_2_NFR_plots,
width = 10, height = 12, dpi = 300)
# table
fully_tables_2 <- list();count_2 = 1
for (i in 1:length(scoreRange)) {
fully_tables_2[[count_2]] <- calculate_metrics(results_2_NFR[[i]])
count_2 = count_2 + 1
}
cat(highlight_metrics(fully_tables_2, method_names =c("Fixed q", "Fixed b", "Polynomial b" , "Random Walk b"),
date_labels = as.character(scoreRange)))
## \begin{table}[htbp]
## \centering
## \caption{Metrics Comparison}
## \begin{tabular}{c|c|c|c|c|c|c|c}
## \hline
## Scenario & RMSE & RMSPE & MAE & MAPE & Interval Width & Coverage Rate & Method \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-01-29}} \\
## \hline
## & 301.14 & 35.17 & 195.28 & 28.80 & \textcolor{red}{91.73} & 0.45 & Fixed q \\
## & 468.14 & 55.50 & 332.65 & 51.94 & 518.42 & 0.55 & Fixed b \\
## & 564.65 & 693.83 & 438.65 & 326.78 & 158.52 & 0.14 & Polynomial b \\
## & \textcolor{red}{143.44} & \textcolor{red}{19.65} & \textcolor{red}{80.21} & \textcolor{red}{13.50} & 423.06 & \textcolor{red}{0.93} & Random Walk b \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-02-12}} \\
## \hline
## & 264.49 & 30.39 & 188.53 & 24.72 & 105.56 & 0.40 & Fixed q \\
## & 928.35 & 97.75 & 790.27 & 97.49 & \textcolor{red}{7.88} & 0.05 & Fixed b \\
## & 549.81 & 933.38 & 489.60 & 372.78 & 244.87 & 0.12 & Polynomial b \\
## & \textcolor{red}{184.68} & \textcolor{red}{20.77} & \textcolor{red}{114.34} & \textcolor{red}{14.58} & 343.71 & \textcolor{red}{0.81} & Random Walk b \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-02-26}} \\
## \hline
## & 234.94 & \textcolor{red}{31.38} & 159.05 & 24.92 & 89.28 & 0.37 & Fixed q \\
## & 832.31 & 98.39 & 679.60 & 98.32 & \textcolor{red}{6.84} & 0.00 & Fixed b \\
## & 401.15 & 228.10 & 326.12 & 105.16 & 203.23 & 0.25 & Polynomial b \\
## & \textcolor{red}{162.94} & 34.13 & \textcolor{red}{95.11} & \textcolor{red}{18.15} & 254.87 & \textcolor{red}{0.84} & Random Walk b \\
## \hline
## \end{tabular}
## \end{table}
results_3_NFR_plots <- nowcasts_plot(results_3_NFR, D = D, report_unit = "day",
models_to_run = c("fixed_q", "fixed_b", "linear_b" , "ou_b"),
combine_plots = T, ncol = 2
)
ggsave(filename = file.path(path_proj, "plots_to_show", "simulation", "NotFR_b01_sd03.png"),
plot = results_3_NFR_plots,
width = 10, height = 12, dpi = 300)
# table
fully_tables_3 <- list();count_3 = 1
for (i in 1:length(scoreRange)) {
fully_tables_3[[count_3]] <- calculate_metrics(results_3_NFR[[i]])
count_3 = count_3 + 1
}
cat(highlight_metrics(fully_tables_3, method_names =c("Fixed q", "Fixed b", "Polynomial b" , "Random Walk b"),
date_labels = as.character(scoreRange)))
## \begin{table}[htbp]
## \centering
## \caption{Metrics Comparison}
## \begin{tabular}{c|c|c|c|c|c|c|c}
## \hline
## Scenario & RMSE & RMSPE & MAE & MAPE & Interval Width & Coverage Rate & Method \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-01-29}} \\
## \hline
## & 353.34 & 41.83 & 228.17 & 33.95 & \textcolor{red}{87.45} & 0.34 & Fixed q \\
## & 723.85 & 92.47 & 553.78 & 90.87 & 98.83 & 0.00 & Fixed b \\
## & 552.10 & 755.31 & 427.53 & 350.49 & 196.21 & 0.17 & Polynomial b \\
## & \textcolor{red}{123.66} & \textcolor{red}{18.48} & \textcolor{red}{69.26} & \textcolor{red}{10.99} & 422.74 & \textcolor{red}{0.97} & Random Walk b \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-02-12}} \\
## \hline
## & 331.42 & 38.27 & 252.98 & 32.69 & 103.86 & 0.21 & Fixed q \\
## & 917.02 & 98.10 & 784.69 & 97.93 & \textcolor{red}{7.40} & 0.02 & Fixed b \\
## & 470.45 & 664.15 & 390.68 & 269.55 & 367.57 & 0.40 & Polynomial b \\
## & \textcolor{red}{206.11} & \textcolor{red}{22.99} & \textcolor{red}{115.34} & \textcolor{red}{14.11} & 294.81 & \textcolor{red}{0.84} & Random Walk b \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-02-26}} \\
## \hline
## & 267.69 & 34.98 & 188.70 & 29.04 & 90.42 & 0.25 & Fixed q \\
## & 823.92 & 98.72 & 678.89 & 98.68 & \textcolor{red}{6.60} & 0.00 & Fixed b \\
## & 371.85 & 484.42 & 290.70 & 177.67 & 253.64 & 0.32 & Polynomial b \\
## & \textcolor{red}{169.19} & \textcolor{red}{25.91} & \textcolor{red}{91.31} & \textcolor{red}{15.30} & 233.65 & \textcolor{red}{0.84} & Random Walk b \\
## \hline
## \end{tabular}
## \end{table}